home *** CD-ROM | disk | FTP | other *** search
/ 1,000 Game Levels 2 / 1,000 Game Levels 2.iso / DOSARC / BOWHUNT.ZIP / GAME.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-21  |  7KB  |  265 lines
  1. Program Game;
  2. Uses Dos, Crt, Graph, VGA256;
  3. Var
  4.    i : integer;     {used for looping}
  5.    regs : registers; {define interupt registers}
  6.    x,y : integer;  { horiz. and vert. position}
  7.    Gd, Gm : integer;
  8.    OldPattern : FillPatternType;
  9.    h, m, s, hund : Word; {hours minutes seconds hundreds for timing routine}
  10.    origsec : word; {original second}
  11.    orighund : word;
  12.    button : integer; {mouse button state}
  13.    Score : integer; {current score}
  14.    hits : integer;  {current amount of hits}
  15.    shotcolor : integer;  {colour of pixel shot}
  16.    MissFlag : boolean; {if miss is true}
  17.    ScoreFile : Text; {high score list text file type}
  18.    Name : Array[1..11] of String;  {player list}
  19.    PlayerScore : Array [1..11] of integer; { high score list }
  20.    Player : string; {acutal player name}
  21.    noshots : integer;
  22. Const
  23.    FileName = 'score.txt';
  24.  
  25. Procedure Title;
  26. begin
  27.      Writeln ('Shoot V1.0');
  28.      Writeln ('Turbo Pascal 7.0  VGA256.TPU ASSEMBLY LANGUAGE CODE ALSO');
  29.      Writeln ('Mouse driver (Int 33h) used');
  30.      Writeln ('Experimental version only');
  31.      readln;
  32. end;
  33.  
  34. Procedure MakeScore;   {save score to disk}
  35. var
  36.    i : integer;  {temp variable for loop}
  37. Begin
  38.      Assign (ScoreFile, filename);     {assign score as score.txt}
  39.      ReWrite (ScoreFile);
  40.      i := 1;
  41.      While I<=10 do begin              {loop and write}
  42.                        Writeln (Scorefile, Name[i]);
  43.                        Writeln (Scorefile, PlayerScore[i]);
  44.                        i:=i+1;
  45.                        end;
  46.      Close (Scorefile);
  47. end;
  48.  
  49. Procedure ReadScore; {input original high score list}
  50. var i : integer;
  51.     Input : Text;
  52. Begin
  53.      assign ( Input, filename );
  54.      Reset (Input);
  55.      i := 1;
  56.      while I<=10 do begin
  57.                       Readln (Input, Name[i]);
  58.                       Readln (Input, PlayerScore[i]);
  59.                       i:=i+1;
  60.                      end;
  61. End;
  62.  
  63. Procedure ReplaceScore;
  64. var num : integer;
  65.     i : integer;
  66.     flag : boolean;
  67. begin
  68.     Flag := False;
  69.     num := 1;      {num = number of score which is lower than player score}
  70.     while flag = false do Begin
  71.                             if PlayerScore[num]> Score then num:=num+1
  72.                                else flag := True;
  73.                           end;
  74.  
  75.     if num<11 then for i:=9 downto num do begin;
  76.                                   PlayerScore[i+1] := PlayerScore[i];
  77.                                   Name[i+1] := name[i];
  78.                                 end;
  79.     if num<11 then
  80.           begin;
  81.              TextColor(LightGreen);
  82.              GotoXY(13,7);
  83.              writeln('Congratulations !  You have entered the hall of fame');
  84.              for i:=100 to 300 do
  85.                         begin
  86.                              sound (i);
  87.                              delay (10);
  88.                         end;
  89.              nosound;
  90.              GotoXY(25,8);
  91.              Write ('Please enter your name : ');
  92.              Read (Player);
  93.              GotoXY(25,8);
  94.              ClrEol;
  95.           end;
  96.     if num<11 then PlayerScore[num]:=Score;
  97.     if num<11 then Name[num]:=Player;  {actual player}
  98.     TextColor(LightMagenta);
  99.     GotoXY(30,8);
  100.     writeln ('High Score List');
  101.     TextColor(Yellow);
  102.     for i:=1 to 10 do begin
  103.                       GotoXY(15,12+i);
  104.                       if i=10 then GotoXY(14,12+i);
  105.                       writeln (i,'.   ',Name[i]);
  106.                       GotoXY(55,12+i);
  107.                       Writeln (PlayerScore[i]);
  108.                       end;
  109.  
  110.  
  111. end;
  112.  
  113.  
  114.  
  115. Procedure MouseOn; Assembler;
  116. asm
  117.      mov ax,1;
  118.      int 33h;
  119. end;
  120.  
  121. Procedure MouseOff; Assembler;
  122. asm
  123.      mov ax,2;
  124.      int 33h;
  125. end;
  126.  
  127. Procedure TestMouse;
  128. begin
  129.      regs.ax := 0;
  130.      intr ($33,regs);
  131.      if regs.ax = 0 then Halt(2);
  132. end;
  133.  
  134. Procedure SetMouse (X : word; Y : word);
  135. begin
  136.      regs.ax := 4;
  137.      regs.cx := X;
  138.      regs.Dx := y;
  139.      intr ($33,regs);
  140. end;
  141.  
  142. Procedure FilledCircle (X : integer; Y:integer; radius : integer; FillColor: Word);
  143. begin
  144.      SetColor (FillColor);
  145.      Circle (X,y,radius);
  146.      SetFillPattern (OldPattern, FillColor);
  147.      FloodFill (X,y, FillColor);
  148. end;
  149.  
  150. Procedure Init;
  151. var
  152.    radius : integer;
  153.  
  154. begin
  155.  
  156.      randomize;
  157.      Gd := Detect;
  158.      InitGraph(Gd, Gm, ' ');
  159.      if GraphResult <> grOk then
  160.                               Halt(1);
  161.      cleardevice;
  162.      GetFillPattern (OldPattern);
  163.      FilledCircle (320,240, 100, Yellow);
  164.      FilledCircle (320,240, 80, Green);
  165.      FilledCircle (320,240, 60, Blue);
  166.      FilledCircle (320,240, 40, Brown);
  167.      FilledCircle (320,240, 20, Red);
  168.      GetTime (h,m,origsec,orighund);
  169.      SetTime (h,m,0,0);
  170.      Origsec := 0;
  171.      orighund := 0;
  172.      TestMouse;
  173.      MouseOn;
  174.      OutTextXY (10,50,'Time :');
  175. end;
  176.  
  177. procedure ShowTime;
  178. var
  179.  
  180.    temp : string;
  181.    timestring : string;
  182. begin
  183.     SetColor (Black);
  184.     OutTextXY (80,50,timestring);
  185.     GetTime (h,m,s,hund);
  186.  
  187.     Str (hund,temp);
  188.     Timestring := temp;
  189.     SetColor (green);
  190.     if s = 1 then begin
  191.                     button :=1 ;
  192.                     timestring := 'Miss';
  193.                     MissFlag := True;
  194.                    end else MissFlag := False;
  195.  
  196.     OutTextXY (80,50,timestring);
  197.  
  198.  
  199. end;
  200.  
  201. Procedure GetMouse;
  202. begin
  203.      regs.ax := 3;
  204.      intr ($33,regs);
  205.      X:= regs.cx;
  206.      y:= regs.dx;
  207.      button :=regs.bx;
  208. end;
  209.  
  210. Procedure CalculateScore;
  211. begin
  212.      if shotColor <> black then if MissFlag = False then
  213.         begin
  214.             hits:=hits+1;
  215.             if shotColor = Red then score :=score + 8*2*(100-hund);
  216.             if shotColor = Brown then score :=score + (6*2*(100-hund));
  217.             if shotColor = Blue then score :=score + (4*2*(100-hund));
  218.             if shotColor = Green then score :=score + (2*2*(100-hund));
  219.             if shotColor = Yellow then score :=score + (1*2*(100-hund));
  220.         end;
  221. end;
  222.  
  223. Procedure ClearTime;
  224. begin
  225.      SetTime (h,m,0,0);
  226. end;
  227.  
  228.  
  229. Procedure DoShots;
  230. begin
  231.      mouseoff;
  232.      SetMouse (random(640),random(480));
  233.      mouseon;
  234.      cleartime;
  235.      repeat
  236.      GetMouse;
  237.      ShowTime;
  238.      until (button = 1);
  239.      Mouseoff;
  240.      ShotColor := GetPixel(x,y);
  241.      CalculateScore;
  242.      filledcircle (x,y,2,white);
  243.      MouseON;
  244. end;
  245.  
  246. begin
  247.      ReadScore;
  248.      for noshots {no of shots } := 1 to 20
  249.           do begin
  250.                init;
  251.                DoShots;
  252.                delay (100);
  253.              end;
  254.      initText;
  255.      TextColor(Lightblue);
  256.      GotoXY(30,3);
  257.      writeln('Total score : ',score);
  258.      GotoXY(15,5);
  259.      TextColor(Red);
  260.      writeln('Out of a possible ',noshots,' shots, a total of ',hits,' scored!');
  261.      ReplaceScore;
  262.      MakeScore;
  263.      mouseoff;
  264. end.
  265.